;;; bencoding.lisp - A library for the "bencode" text encoding

;; Author: Cal Paterson <cal.paterson@googlemail.com>

;; Copyright (C) 2008 Cal Paterson

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, see
;; <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; TODO:
;; Encoding doesn't work - use the reference algorithm
;; Improve comments
;; Use the reference encoding algorithm
;; Use hash-tables rather than alists

(defpackage :bencoding
  (:use :common-lisp
	:split-sequence)
  (:export :bencode
	   :unbencode
	   ;for testing
	   :unbencode-string
	   :unbencode-integer
	   :unbencode-list
	   :unbencode-dictionary))

(in-package :bencoding)
	   
; This should be removed, it is a bug
(defun char-to-int (char)
  (parse-integer (string char)))

;; Encoding
;; This is extremely slow, could be improved by stealing the mainline algo.

(defun integer-to-bencode (integer)
  (concatenate 'string "i" (write-to-string integer) "e"))

(defun string-to-bencode (string)
  (concatenate 'string (write-to-string (length string)) ":" string))

(defun list-to-bencode (list)
  (concatenate 'string "l"
	       (apply #'concatenate 'string (mapcar #'bencode list)) "e"))

(defun alist-to-bencode (alist)
  "FIXME: Could be presented better"
  (concatenate 'string
	       "d"
	       (apply #'concatenate 'string
		      (mapcar #'(lambda (x)
				  (concatenate 'string
					       (bencode (first x))
					       (bencode (cdr x))))
			      alist)) "e"))

(defun bencode (input)
  "Bencodes the input
FIXME: Could use AND and OR."
  (cond ((integerp input) (integer-to-bencode input))
	((stringp input) (string-to-bencode input))
	((listp input) (alist-to-bencode input)) ;FIXME:should be alistp
	((listp input) (list-to-bencode input))))

;;; Decoding
;; The basic algorithm here was taken from the mainline implementation
;; of bencode.py.  Essentially, the design is to pass the bencode data
;; structure to #'unbencode and then that function will attempt to
;; pass the bencoded string around to other functions so they can
;; decode that part of a string.

(defun unbencode-integer (bencode position)
  "This is the function for decoding integers.
It takes a bencoded string as input and the position to start the decoding.
It returns the integer and the final index+1"
  ;; FIXME: start-location not being set right
  ;; test: (unbencode-list "li42ei53ee")
  (let* ((end-location (search "e" bencode :start2 position))
	 (integer (parse-integer
		   (subseq bencode position end-location))))
    (list integer (+ 1 end-location))))

(defun unbencode-string (bencode position)
  "This is the function for decoding strings.
It takes the the bencode and the current position as input, and returns
the bencode and the ending position."
  (let* ((length
	  (parse-integer (string
			  (subseq bencode position (search ":" bencode)))))
	 (prefix-length (+ 1 (length (write-to-string length)))))
    (list (subseq bencode (+ prefix-length position)
		  (+ prefix-length position length))
	  (+ position prefix-length length))))

(defun unbencode-list (bencode position)
  "This is the function for decoding lists.
It takes a bencoded list as input and the position to start the decoding.
It returns the list and the index of the final index+1"
  ;;FIXME: Does not work for nested lists
  (let ((return-list nil)
	(temp nil))
    (loop while (not (equal (elt bencode position) #\e)) do
	  (progn
	    (setf temp (unbencode-iterator bencode position))
	    (setf position (second temp))
	    (setf return-list (cons (first temp) return-list))))
    (list (reverse return-list) (+ 1 position))))

(defun unbencode-dictionary (bencode position)
  "This function translates a bencoded dictionary into a "
  (let ((return-list nil)
	(key nil)
	(value nil))
    (loop while (not (equal (elt bencode position) #\e))
	  do (multiple-value-setq (key position)
	       (values-list (unbencode-string bencode position)))
	  do (multiple-value-setq (value position)
	       (values-list (unbencode-iterator bencode position)))
	  do (setf return-list (acons key value return-list)))
    return-list))
	  

(defun unbencode-iterator (bencode position)
  (let ((current-character (elt bencode position)))
    (cond
     ((equal current-character #\i) (unbencode-integer bencode (+ position 1)))
     ((equal current-character #\l) (unbencode-list bencode (+ position 1)))
     ((equal current-character #\d) (unbencode-dictionary bencode (+ position 1)))
     (t (unbencode-string bencode position)))))

(defun unbencode (bencode)
  (first (unbencode-iterator bencode 0)))